(defstruct add x y) 
(defstruct mul x y) 

(defgeneric simplify-add (x y) 
   (:method ((x number) (y number)) (+ x y)) 
   (:method ((x (eql 0)) y) y) 
   (:method (x (y (eql 0))) x) 
   (:method (x (y add)) 
    (simplify-add (simplify-add x (add-x y)) (add-y y))) 
   (:method (x y) (make-add :x x :y y))) 

(defgeneric simplify-mul (x y) 
   (:method ((x number) (y number)) (* x y)) 
   (:method ((x (eql 0)) y) 0) 
   (:method (x (y (eql 0))) 0) 
   (:method ((x (eql 1)) y) y) 
   (:method (x (y (eql 1))) x) 
   (:method (x (y mul)) 
    (simplify-mul (simplify-mul x (mul-x y)) (mul-y y))) 
   (:method (x y) (make-mul :x x :y y))) 

(defgeneric simplify-pascal (exp) 
   (:method (exp) exp) 
   (:method ((exp add)) 
    (simplify-add (simplify-pascal (add-x exp)) (simplify-pascal (add-y exp)))) 
   (:method ((exp mul)) 
    (simplify-mul (simplify-pascal (mul-x exp)) (simplify-pascal (mul-y exp))))) 

(setq *expr* (make-mul :x 'x 
             :y (make-add :x (make-add :x (make-mul :x 12 :y 0) 
                                       :y (make-add :x 23 :y 8)) 
                          :y 'y))) 

(defun tt (N) (gc) (time (test N)))

(defun test (N)
     (COND ((ZEROP N) 0)
         (T (simplify-pascal *expr*) (test (1- N)))))
  
(mapc 'compile '(tt test simplify-add simplify-mul simplify))

 


